perm filename REGION[1,BGB] blob
sn#023247 filedate 1973-02-23 generic text, type T, neo UTF8
00100 TITLE REGION; CONVERT POLYGONS TO REGION BIT ARRAY. 29 JANUARY 1973.
00200
00300 COMMENT/
00400 The ten subroutines of this file compute the region of a bit
00500 array corresponding to the interior of a CRE polygon vector image.
00600
00700 REGION; MAIN CALL - MAKE REGION FROM FIRST IMAGE OF THE FILM.
00800 MKPEAK(PGON1); MAKE RING OF PEAKS OF POLYGON.
00900 MKSCAN; FILL ALL SCAN LINES OF PEAKS' RING.
01000 MKSEGS; SEGMENT MAKES AND FISSIONS.
01100 FILL; FILL ONE SCAN LINE INTO PAK ARRAY.
01200 KLSEGS; SEGMENT KILLS AND FUSIONS.
01300
01400 KLPEAK(PEAK); KILL PEAK FROM RING OF PEAKS.
01500 KLSEG(SEG); KILL SEGMENT FROM RING OF SEGMENTS.
01600 LTXING(SEG); SCAN FOR LEFT TERMINATOR CROSSING.
01700 RTXING(SEG); SCAN FOR RIGHT TERMINATOR CROSSING.
01800
01900 /
02000
02100 ;segment node - defn: a segment is a portion of a scan line.
02200
02300 DEFINE LDEL(A,Q){CAR A,3(Q)}↔DEFINE LDEL.(A,Q){DIP A,3(Q)}
02400 DEFINE RDEL(A,Q){CDR A,3(Q)}↔DEFINE RDEL.(A,Q){DAP A,3(Q)}
02500 DEFINE LCOL(A,Q){CAR A,4(Q)}↔DEFINE LCOL.(A,Q){DIP A,4(Q)}
02600 DEFINE RCOL(A,Q){CDR A,4(Q)}↔DEFINE RCOL.(A,Q){DAP A,4(Q)}
02700 DEFINE LROW(A,Q){CAR A,5(Q)}↔DEFINE LROW.(A,Q){DIP A,5(Q)}
02800 DEFINE RROW(A,Q){CDR A,5(Q)}↔DEFINE RROW.(A,Q){DAP A,5(Q)}
02900 DEFINE LT (A,Q){CAR A,6(Q)}↔DEFINE LT. (A,Q){DIP A,6(Q)}
03000 DEFINE RT (A,Q){CDR A,6(Q)}↔DEFINE RT. (A,Q){DAP A,6(Q)}
03100
03200
03300 ;VARIABLES GLOBAL TO THE SUBROUTINES IN THIS FILE.
03400
03500 PEAK0: 0 ;ORDERED RING OF PEAK VERTICES.
03600 SEG0: 0 ;ORDERED RING OF SEGMENTS.
03700 ROW0: 0 ;CURRENT SCAN LINE ROW POSITION.
03800
03850 INTERN PAK,PAKPTR
03900 PAKBIT: 0 ;BIT FOR REGION PACKING.
04000 PAK: 0 ;PICTURE ACCUMULATOR 216 ROWS OF 288 BITS/ROW.
04100 BLOCK =1728
04300 PAKPTR: ;PAK COLUMN BIT ADDRESS VECTOR.
04400 RADIX 12
04500 FOR I←0,7{
04600 FOR J←0,=35{POINT 1,PAK+I(2),J
04700 }}↔RADIX 8
04900 DECLARE{RMIN,RMAX,CMIN,CMAX}
05000 EXTERN MAKE,KILL,FILM
05100 INTERN RMIN,RMAX,CMIN,CMAX
00100 SUBR(REGION)-------------------------------------------------------
00200 BEGIN REGION;MAKE REGION BIT ARRAY OF FIRST IMAGE OF THE FILM.
00300 ;BGB - 30 JANUARY 1973.
00400
00500 LAC 1,FILM↔SON 1,1↔SKIPN 1↔POP0J ;IMAGE.
00600 SON 1,1↔SKIPN 1↔POP0J ;LEVEL.
00700 SON 1,1↔SKIPN 1↔POP0J ;POLYGON.
00800 DAC 1,PGON0#↔DAC 1,PGON1#
00900
01000 ;CLEAR PAK ARRAY.
01100
01200 SETZM PAK↔LAC[XWD PAK,PAK+1]↔BLT PAK+=1727
01300 SETZM CMAX↔SETZM RMAX
01400 LACI =288↔DAC CMIN
01500 LACI =216↔DAC RMIN
01600
01700 ;BLOB POLYONS TO SCAN BIT ARRAY.
01800
01900 SETOM PAKBIT
02000 L1: LAC 1,PGON1↔TEST 1,HOLBIT↔GO L2
02100 CALL(ZIPARC,PGON1)
02200 CALL(MKPEAK,PGON1)
02300 CALL(MKSCAN)
02400 CALL(ZIPARC,PGON1)
02500 L2: LAC 1,PGON1↔CCW 1,1↔DAC 1,PGON1
02600 CAME 1,PGON0↔GO L1
02700
02800 ;HOLE POLYGONS TO BIT SCAN ARRAY.
02900
03000 SETZM PAKBIT
03100 L3: LAC 1,PGON1↔TESTZ 1,HOLBIT↔GO L4
03200 CALL(MKPEAK,PGON1)
03300 CALL(MKSCAN)
03400 L4: LAC 1,PGON1↔CCW 1,1↔DAC 1,PGON1
03500 CAME 1,PGON0↔GO L3
03600 EXTERN DPYPAK↔CALL(DPYPAK)
03700 POP0J
03800
03900 BEND;1/31/73------------------------------------------------------
04000
04100 SUBR(ZIPARC)PGON---------------------------------------------------
04200 LAC 1,ARG1↔SON 1,1↔DAC 1,2↔SETZ
04300 ARC. 0,1↔CCW 1,1↔CAME 1,2↔GO .-3
04400 POP1J
04500 ;2/3/73-----------------------------------------------------------
00100 SUBR(MKPEAK)-------------------------------------------------------
00200 BEGIN MKPEAK;MAKE ORDERED RING OF PEAK VERTICES OF A POLYGON.
00300 ;BGB - 30 JANUARY 1973.
00400
00500 ACCUMULATORS{PG,V0,V1,V2,R0,R1,R2}
00600
00700 ;UPPERMOST LEFT IS ALWAYS THE FIRST PEAK VERTEX.
00800
00900 LAC PG,ARG1↔SON V1,PG
01000 DAC V1,PEAK0↔MARK V1,TMPBIT
01100 DIP V1,6(V1)↔DAP V1,6(V1)
01200 ROW R1,V1
01300 CCW V2,V1↔ROW R2,V2
01400
01500 ;ADVANCE CCW TO NEXT VECTOR.
01600
01700 L1: LAC V0,V1↔LAC R0,R1
01800 LAC V1,V2↔LAC R1,R2
01900 CCW V2,V2↔ROW R2,V2
02000 CAMN V1,PEAK0↔POP1J ;EXIT
02100
02200 ;TEST V1 FOR PEAK'ED'NESS.
02300 CAMLE R1,R0↔GO L1
02400 CAMLE R1,R2↔GO L1
03200
03300 ;SCAN UP THE PEAK RING FOR V1'S PLACE.
03400
03410 L2: MARK V1,TMPBIT;USE TMPBIT MARK FOR PEAK.
03500 SKIPA 2,PEAK0↔LAC 2,1
03600 CAR 1,6(2)↔ROW 0,1
03700 CAMLE 0,R1↔GO .-4
03800
03900 ;PLACE V1 INTO THE PEAKS RING.
04000
04100 DIP 1,6(V1)↔DAP V1,6(1)
04200 DAP 2,6(V1)↔DIP V1,6(2)
04300 GO L1
04400
04500 BEND;1/31/73------------------------------------------------------
00100 SUBR(MKSCAN)-------------------------------------------------------
00200 BEGIN MKSCAN;MAKE ALL THE SCAN LINES IMPLIED BY THE PEAKS' RING.
00300
00400 ;TOP PEAK OF THE POLYGON DETERMINES ROW0.
00500
00600 LAC 1,PEAK0↔ROW 0,1
00700 ANDCMI 0,77↔DAC 0,ROW0
00800
00900 ;ADVANCE ROW0 UNTIL THE PEAK AND SEGMENT RINGS ARE EMPTY.
01000
01100 L1: LAC PEAK0↔IOR SEG0
01200 SKIPN↔POP0J
01300 LACI 100↔ADDM ROW0
01400
01500 CALL(MKSEGS) ;START SEGMENTS - SEGMENT MAKES & FISSIONS.
01600 CALL(FILL) ;RING OF SEGMENTS TO A ROW OF BITS.
01700 CALL(KLSEGS) ;ADVANCE SEGMENTS - SEGMENT KILLS & FUSIONS.
01800 GO L1
01810
01900
02000 BEND;1/31/73------------------------------------------------------
00100 SUBR(MKSEGS)-------------------------------------------------------
00200 BEGIN MKSEGS;START SEGMENTS - SEGMENT MAKES & FISSIONS.
00300
00400 ACCUMULATORS{L,R,SEG2,SEG1,PK,PK2,SEG}
00500
00600 ;TAKE THE PEAKS ABOVE THE CURRENT SCAN LINE.
00700 L1: SKIPN PK,PEAK0↔POP0J
00800 ROW 0,PK↔CAML 0,ROW0↔POP0J
00900 CALL(KLPEAK,PK)
01000 CW PK2,PK
01100
01200 ;CREATE PROTO SEGMENT.
01300 SETQ(SEG,{MAKE,[1]})
01400 CW. SEG,SEG↔CCW. SEG,SEG
01500 LT. PK,SEG↔ARC. SEG,PK
01600 RT. PK2,SEG↔ARC. SEG,PK2
01700
01800 ;FIND SCAN LINE CROSSINGS (IF ANY).
01900 CALL(LTXING,SEG)
02000 GO[CALL(KLSEG,SEG)↔GO L1]
02100 CALL(RTXING,SEG)
02200 GO[CALL(KLSEG,SEG)↔GO L1]
02300
02400 ;PLACE SEGMENT INTO THE ORDERED SEGMENT RING.
02500 SKIPN 1,SEG0↔GO[DAC SEG,SEG0↔GO L1] ;SHINEY NEW RING.
02600 LCOL L,SEG↔RCOL R,SEG
02700 CAMLE L,R↔GO L2 ;FISSION.
02800
02900 ;NO FISSION.
03000 LCOL L,1↔CAMLE R,L↔GO[ ;SKIP ON RIGHT NEIGHBOR FOUND.
03100 CCW 1,1↔CAME 1,SEG0↔GO .-2↔GO .+3]
03200 CAMN 1,SEG0↔DAC SEG,SEG0 ;POSSIBLE NEW LEFTMOST.
03300 CW 2,1
03400 CW. 2,SEG↔CCW. 1,SEG
03500 CCW. SEG,2↔CW. SEG,1
03600 GO L1
03700 ;------------------------------------------------------------------
00100 COMMENT/FISSION---------------------------------------------------
00200
00300 BEFORE: _____________SEG1____________
00400 | _____________ |
00500 | | SEG2 | |
00600 LT RT LT RT
00700
00800 AFTER:
00900 LT RT LT RT
01000 | SEG1 | | SEG2 |
01100 |_______| |_______|
01200 ;-----------------------------------------------------------------/
01300
01400 L2: LAC 0,R↔ADD 0,L↔ASH 0,-1 ;MIDPOINT OF SEG2.
01500 LAC SEG2,SEG↔LAC SEG1,SEG0
01600
01700 L3: LCOL L,SEG1↔RCOL R,SEG1
01800 CAMG L,0↔CAMLE 0,R↔GO[ ;TEST FOR SEG2 WITHIN SEG1.
01900
02000 ;ADVANCE OR BLOWUP.
02100 CCW SEG1,SEG1↔CAME SEG1,SEG0↔GO L3
02200 FATAL({DANGLING FISSION HOLE.})]
02300
02400 ;SWAP RIGHT TERMINATORS.
02500 RDEL 0,SEG1↔RDEL 1,SEG2↔RDEL. 1,SEG1↔RDEL. 0,SEG2
02600 RCOL 0,SEG1↔RCOL 1,SEG2↔RCOL. 1,SEG1↔RCOL. 0,SEG2
02700 RROW 0,SEG1↔RROW 1,SEG2↔RROW. 1,SEG1↔RROW. 0,SEG2
02800 RT 1,SEG1↔ARC. SEG2,1
02900 RT 2,SEG2↔ARC. SEG1,2
03000 RT. 2,SEG1↔RT. 1,SEG2
03100
03200 ;PLACE SEG2 INTO THE ORDERED SEGMENT RING CCW OF SEG1.
03300 CCW 1,SEG1
03400 CCW. 1,SEG2↔CW. SEG2,1
03500 CW. SEG1,SEG2↔CCW. SEG2,SEG1
03600 GO L1
03700 BEND;1/31/73------------------------------------------------------
00100 SUBR(FILL)---------------------------------------------------------
00200 BEGIN FILL;FILL BITS INTO PAK MATRIX.
00300 ACCUMULATORS{R,C1,C2,BIT,SEG}
00400
00500 SKIPN SEG,SEG0↔POP0J
00600 LAC BIT,PAKBIT
00700 LAC R,ROW0↔LSH R,-6
00800 CAMLE R,RMAX↔DAC R,RMAX
00900 CAMGE R,RMIN↔DAC R,RMIN
01000 LSH R,3
01100
01200 L1: LCOL C1,SEG↔LSH C1,-6
01300 RCOL C2,SEG↔LSH C2,-6
01400 SKIPGE C1↔SETZ C1,
01500 SKIPGE C2↔SETZ C2,
01600 CAILE C1,=287↔LACI C1,=287
01700 CAILE C2,=287↔LACI C2,=287
01800 CAMLE C1,CMAX↔DAC C1,CMAX↔CAMGE C1,CMIN↔DAC C1,CMIN
01900 CAMLE C2,CMAX↔DAC C2,CMAX↔CAMGE C2,CMIN↔DAC C2,CMIN
02000
02100 L2: CAMLE C1,C2↔GO .+3
02200 DPB BIT,PAKPTR(C1)↔AOJA C1,L2
02300
02400 CCW SEG,SEG
02500 CAME SEG,SEG0↔GO L1
02600 POP0J
02700
02800 BEND;1/31/73------------------------------------------------------
00100 SUBR(KLSEGS)-------------------------------------------------------
00200 BEGIN KLSEGS;ADVANCE - SEGMENT KILLS AND FUSIONS.
00300
00400 SEG←16
00500 SKIPN SEG,SEG0↔POP0J↔DAC SEG,SEGMEN#
00600 GO L2
00700
00800 ;UPDATE COLUMN LOCII.
00900 L1: SKIPN SEG0↔POP0J
01000 SKIPN SEG,SEGMEN↔POP0J
01050 SKIPN 2(SEG)↔POP0J
01100 CCW SEG,SEG↔CAMN SEG,SEG0↔POP0J
01200 L2: LCOL 0,SEG↔LDEL 1,SEG↔ADD 0,1↔LT 2,SEG↔COL 2,2
01300 JUMPL 1,[SOS 2↔CAMGE 0,2↔DAC 2,0↔GO .+4]
01350 AOS 2↔CAMLE 0,2↔DAC 2,0
01400 LCOL. 0,SEG
01500 RCOL 0,SEG↔RDEL 1,SEG↔ADD 0,1↔RT 2,SEG↔COL 2,2
01600 JUMPL 1,[SOS 2↔CAMGE 0,2↔DAC 2,0↔GO .+4]
01650 AOS 2↔CAMLE 0,2↔DAC 2,0
01700 RCOL. 0,SEG
01800 DAC SEG,SEGMEN
01900
02000 ;TEST FOR END OF LEFT TERMINATOR.
02100 LROW 0,SEG↔CAMLE 0,ROW0↔GO L3
02200 CALL(LTXING,SEG)↔SKIPA↔GO L3
02300
02400 ;SEGMENT DEATH.
02500 CAME 1,SEGMEN↔GO[
02600 FATAL({KLSEG - UNEXPECTED SEGMENT FUSION.})]
02700 CCW 0,1↔CAMN 0,1↔SETZ↔DAC 0,SEGMEN
02800 CALL(KLSEG,1)
02802 SKIPN SEG0↔POP0J
02804 SKIPN SEG,SEGMEN↔POP0J↔GO L2
02900
03000 ;TEST FOR END OF RIGHT TERMINATOR.
03100 L3: LAC SEG,SEGMEN
03200 RROW 0,SEG↔CAMLE 0,ROW0↔GO L1
03300 CALL(RTXING,SEG)↔SKIPA↔GO L1
03400 CAMN 1,SEGMEN↔GO[
03500 FATAL({KLSEG - UNEXPECTED SEGMENT DEATH})]
03600
03700 ;SEGMENT FUSION - REPLACE RT(SEG) ← RT(SEG2).
03800 RDEL 0,1↔RDEL. 0,SEG
03900 RCOL 0,1↔RCOL. 0,SEG
04000 RROW 0,1↔RROW. 0,SEG
04100 RT 2,1↔RT. 2,SEG↔ARC. SEG,2
04200 CALL(KLSEG,1)
04300 GO L3 ;NOTA BENE ! WE HAVE YET TO DO THE RT OF THIS SEG.
04400
04500 BEND;1/31/73------------------------------------------------------
00100 SUBR(KLSEG)SEG-----------------------------------------------------
00200 BEGIN KLSEG;KILL SEGMENT - AC TRANSPARENT.
00300 DAC 2,AC2↔DAC 3,AC3↔LAC 3,ARG1
00302 ;CLEAN UP ARC LINKS.
00304 SETZ↔LT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
00306 SETZ↔RT 1,3↔ARC 2,1↔CAMN 2,3↔ARC. 0,1
00308
00310 ;RING OUT AND KILL THE SEGMENT.
00500 CW 1,3↔CCW 2,3
00600 CCW. 2,1↔CW. 1,2
00700 CAMN 1,3↔SETZ 2,
00800 CAMN 3,SEG0↔DAC 2,SEG0
00900 CALL(KILL,3)
01000 LAC 2,AC2↔LAC 3,AC3
01100 POP1J
01200 BEND;1/31/73------------------------------------------------------
01300
01400 SUBR(KLPEAK)-------------------------------------------------------
01500 BEGIN KLPEAK;KILL PEAK VERTEX - AC TRANSPARENT.
01600 DAC 2,AC2↔DAC 3,AC3
01700 LAC 3,ARG1↔MARKZ 3,TMPBIT
01800 CAR 1,6(3)↔CDR 2,6(3)↔SETZM 6(3)
01900 DAP 2,6(1)↔DIP 1,6(2)
02000 CAMN 2,3↔SETZ 2,
02100 CAMN 3,PEAK0↔DAC 2,PEAK0
02200 LAC 2,AC2↔LAC 3,AC3
02300 POP1J
02400 BEND;1/31/73------------------------------------------------------
00100 SUBR(LTXING)SEG----------------------------------------------------
00200 BEGIN LTXING;LEFT TERMINATOR CROSSING - BGB - 30 JANUARY 1973.
00300
00400 ACCUMULATORS{SEG,V0,V1,V2,R1,R2}
00500 LAC SEG,ARG1
00600 LT V2,SEG↔ROW R2,V2↔DAC V2,V0
00700
00800 ;ADVANCE ALONG POLYGON'S PERIMETER.
00900 L1: LAC V1,V2↔LAC R1,R2
01000 CCW V2,V2↔ROW R2,V2
01100 CAMN V2,V0↔POP1J ;EXIT NO CROSSING.
01200 ARC 1,V2↔SKIPE 1↔POP1J ;EXIT SEGEMENT FOUND.
01300
01400 ;ROW0 CROSSING TEST.
01500 CAMLE R2,ROW0↔GO L2
01600 TEST V2,TMPBIT↔GO L1 ;NO CROSSING YET.
01700 CALL(KLPEAK,V2)↔GO L1 ;KILL SPURIOUS PEAK.
01800
01900 ;NEW LEFT TERMINATOR.
02000 L2: SETZ↔LT 1,SEG↔SKIPE 1↔ARC. 0,1
02100 LT. V1,SEG↔ARC. SEG,V1↔LROW. R2,SEG ;LAST ROW.
02200
02300 ;LDEL←(C2-C1)/(R2-R1).
02400 COL 0,V2↔COL 1,V1
02500 SUB 0,1↔ASH 0,6
02600 SUB R2,R1↔IDIV 0,R2
02700 LDEL. 0,SEG
02800
02900 ;LCOL ← LDEL*(ROW0-R1)
03000 ; LAC 1,ROW0↔SUB 1,R1
03100 ; IMUL 0,1↔ASH 0,-6
03200 ; COL 1,V1↔ADD 0,1
03250 COL 0,V1
03300 LCOL. 0,SEG
03400 AOS(P)↔POP1J ;RETURN SKIP.
03500
03600 BEND;1/30/73------------------------------------------------------
00100 SUBR(RTXING)SEG----------------------------------------------------
00200 BEGIN RTXING;RIGHT TERMINATOR CROSSING - BGB - 30 JANUARY 1973.
00300
00400 ACCUMULATORS{SEG,V0,V1,V2,R1,R2}
00500 LAC SEG,ARG1
00600 RT V2,SEG↔ROW R2,V2↔DAC V2,V0
00700
00800 ;ADVANCE ALONG POLYGON'S PERIMETER.
00900 L1: LAC V1,V2↔LAC R1,R2
01000 CW V2,V2↔ROW R2,V2
01100 CAMN V2,V0↔POP1J ;EXIT NO CROSSING.
01200 ARC 1,V2↔SKIPE 1↔POP1J ;EXIT SEGMENT FOUND.
01300
01400 ;ROW0 CROSSING TEST.
01500 CAMLE R2,ROW0↔GO L2
01600 ARC 1,V2↔SKIPE 1↔POP1J ;EXIT SEGMENT HIT.
01700 TEST V2,TMPBIT↔GO L1 ;NO CROSSING YET.
01800 CALL(KLPEAK,V2)↔GO L1 ;KILL SPURIOUS PEAK.
01900
02000 ;NEW RIGHT TERMINATOR.
02100 L2: SETZ↔RT 1,SEG↔SKIPE 1↔ARC. 0,1
02200 RT. V1,SEG↔ARC. SEG,V1↔RROW. R2,SEG ;LAST ROW.
02300
02400 ;RDEL←(C2-C1)/(R2-R1).
02500 COL 0,V2↔COL 1,V1
02600 SUB 0,1↔ASH 0,6
02700 SUB R2,R1↔IDIV 0,R2
02800 RDEL. 0,SEG
02900
03000 ;RCOL ← RDEL*(ROW0-R1)
03100 ; LAC 1,ROW0↔SUB 1,R1
03200 ; IMUL 0,1↔ASH 0,-6
03300 ; COL 1,V1↔ADD 0,1
03350 COL 0,V1
03400 RCOL. 0,SEG
03500 AOS(P)↔POP1J ;RETURN SKIP.
03600
03700 BEND;1/30/73------------------------------------------------------
03800
03900 END
04000 EOF - REGION.